The Original Shareware 1.1/The Original Shareware (WeMake CDs)(Volume 1.1)(CDs, Inc)(1993).iso/32/cellar.zip/CELLAR.ASC

Text File | 1988-08-17 | 42KB | 1,752 lines

*dCELLAR.CMD:  Routine for finding or creating wine entry for personal
*              collection, then adding commentary.
*COPYRIGHT (C) 1985 By Stephen L. Haynes Associates, Inc.
*REV:  11/23/85

*FOLLOWING IS STRUCTURE FOR CELLAR.DBF

* NUMBER    C 004
* KEY       C 010
* VINEYARD  C 040
* NAME      C 040
* SPECIAL   C 040
* APPELL    C 030
* REGION    C 006
* TYPE      C 006

* FOLLOWING IS STRUCTURE FOR CELLSTOR.DBF

* NUMBER    C 004 000
* YEAR      C 002 000
* IMPORTER  C 020 000
* PUR:STORE C 040 000
* PUR:DATE  C 008 000
* PRICE     N 006 002
* VALUE     N 006 002
* BOTTLES   N 002 000
* RACKED    N 001 000
* BEGIN     C 004 000
* END       C 005 000
* BIN       C 007 000
* CONTINUE  L 001 000

* FOLLOWING IS STRUCTURE FOR VINTAGE.DBF

* NUMBER    C 004 000
* YEAR      C 002 000
* DATE      C 008 000
* FORMAT    C 010 000
* CLARITY   N 003 001
* COLOR     N 003 001
* LOOKS1    C 050 000
* LOOKS2    C 050 000
* BOUQUET   N 003 001
* ACESCENCE N 003 001
* NOSE1     C 050 000
* NOSE2     C 050 000
* NOSE3     C 050 000
* ACID      N 003 001
* SWEET     N 003 001
* BODY      N 003 001
* FLAVOR    N 003 001
* TANNIN    N 003 001
* FINISH    N 003 001
* TASTE1    C 050 000
* TASTE2    C 050 000
* TASTE3    C 050 000
* GENERAL   N 003 001
* OVERALL1  C 050 000
* OVERALL2  C 050 000
* SCORE     N 004 001
* POSTSCRIPTC 050 000

* NOTE:  THE FOREGOING THREE FILE STRUCTURE DEFINITIONS MAY BE DELETED
*        ONCE THE STRUCTURES HAVE BEEN CREATED.

* PROGRAM BEGINS HERE:

CLEAR
SET TALK OFF
SET EXACT OFF

USE Cellar

IF # = 0
    USE CellStor
    INDEX ON Number+Year TO CellStor
    USE Cellar
    STORE 0 TO FinalWine
    INDEX ON Key TO Cell/Key
    INDEX ON Number TO Cell/Num
ELSE
    GOTO BOTTOM
    STORE VAL(Number) TO FinalWine
    SET INDEX TO Cell/Key,Cell/Num
ENDIF

STORE '1' TO Rack

SELECT SECONDARY
USE Vintage

IF # = 0
    INDEX ON Number+Year TO Vntg/Key
ELSE
    SET INDEX TO Vntg/Key
ENDIF

STORE T TO Status
SELECT PRIMARY

STORE T TO GoOn

DO WHILE GoOn

    DO WineFind

    IF WineKey = '  '
        STORE F TO GoOn
        LOOP
    ENDIF

    IF NoHit

        STORE F TO Choice

        @ 12,23 SAY "DO YOU WISH TO TRY A DIFFERENT KEY?"
        @ 14,40 GET Choice PICTURE '!'
        READ

        IF Choice
            LOOP
        ENDIF

        DO NewWine
    ENDIF

    DO WineData

    STORE T TO GoOn
ENDDO

ERASE

IF LEN(Rack) > 1

    SELECT SECONDARY
    USE CellStor INDEX CellStor

    DO WHILE LEN(Rack) > 1

        STORE $(Rack,1,6) TO Next
        STORE $(Rack,7) TO Rack

        FIND '&Next'

        IF # <> 0

            LOCATE NEXT 10 FOR Racked > 0

            IF Number + Year = Next

                REPLACE Racked WITH Racked - 1
            ELSE
                ? 'KEY/YEAR NOT FOUND:  '+Next
            ENDIF
        ENDIF
    ENDDO

    WAIT
ENDIF

CLEAR
RETURN

* WINEFIND.CMD: Sub-routine to find an individual entry in the data base.
* COPYRIGHT (C) 1985 By Stephen L. Haynes Associates, Inc.
* REV:  11/23/85

ERASE
STORE '          ' TO WineKey
STORE '  ' TO Annum

@  3,20 SAY "ENTER NAME KEY OF WINE TO BE SEARCHED FOR:"
@  5,35 GET WineKey PICTURE '!!!!!!!!!!'

@  8,27 SAY "ENTER VINTAGE YEAR CONCERNED"
@ 10,39 GET Annum PICTURE '!!'
@ 14,19 SAY "'NV' FOR NON-VINTAGE"
@ 16,19 SAY "IF NO ENTRY, SYSTEM WILL DISPLAY SELECTIONS"
@ 17,19 SAY "IN STORAGE AND ALL TASTING NOTES"
@ 20,19 SAY "(BLANKS IN BOTH FIELDS TERMINATES SESSIONS)"
READ

IF WineKey = '  '
    RETURN
ENIF

STORE T TO NoHit
STORE 0 TO NumHits1
STORE F TO SingleHit

FIND &WineKey

IF # = 0
    STORE N TO NameFound
ELSE
    STORE Y TO NameFound
ENDIF

IF NameFound

    SKIP

    IF Key <> WineKey

        SKIP -1

        STORE ' ' TO Pick
        STORE T TO SingleHit

        ERASE
        @  1,24 SAY "IS THE FOLLOWING THE PROPER ENTRY?"
        @  3, 1 GET Pick PICTURE '!'
        @  3, 4 SAY $(TRIM(Vineyard) + ' ' + TYPE + ' ' + TRIM(Name),1,74)
        @  4, 6 SAY $(TRIM(Special) + ' (' + TRIM(Appell) + ')',1,72)
        READ

        IF Pick <> 'N' .AND. Pick <> ' '
            ERASE
            STORE F TO NoHit
            RETURN
        ELSE
            STORE N TO NameFound
        ENDIF
    ELSE
        IF .NOT. EOF
            SKIP -1
        ENDIF

        STORE N TO Hit

        DO WHILE .NOT. Hit

            DO WHILE Key = WineKey

                STORE 3 TO Line
                STORE 1 TO Counter

                ERASE
                @  1,19 SAY "ARE ANY OF THE FOLLOWING THE PROPER ENTRY?"

                DO WHILE COUNTER < 10 .AND. Key = WineKey

                    STORE STR(Counter,1) TO Tag
                    STORE ' ' TO Hit&Tag
                    STORE # TO Data&Tag

                    @  Line  , 1 GET Hit&Tag PICTURE '!'
                    @  Line  , 4 SAY $(TRIM(Vineyard) + ' ' +;
                         TYPE + ' ' + TRIM(Name),1,74)
                    @  Line+1, 6 SAY $(TRIM(Special) + ' (' +;
                         TRIM(Appell) + ')',1,72)

                    STORE Line + 2 TO Line
                    STORE Counter + 1 to Counter
                    SKIP

                ENDDO
                READ

                STORE Counter TO LastCount
                STORE LastCount + NumHits1 TO NumHits1

                STORE 1 TO Counter

                DO WHILE Counter < LastCount

                    STORE STR(Counter,1) TO Tag

                    IF Hit&Tag <> ' '
                        STORE Data&Tag to X
                        GOTO X
                        ERASE
                        STORE F TO NoHit
                        RETURN
                    ENDIF

                    STORE Counter + 1 TO Counter

                ENDDO
            ENDDO

            IF Key <> WineKey
                STORE N TO NameFound
                STORE Y TO Hit
            ENDIF
        ENDDO
    ENDIF
ENDIF

ERASE
@ 10,21 SAY "NO DATA BASE ENTRY SATISFIES THIS SEARCH"
RETURN

* NEWWINE.CMD:  Subroutine to enter new vineyard information
* COPYRIGHT (C) 1982 By Stephen L. Haynes Associates, Inc.
* REV:  11/11/82

APPEND BLANK

STORE FinalWine + 1 TO FinalWine

DO CASE

    CASE FinalWine < 10
        REPLACE Number WITH STR(FinalWine,1)
    CASE FinalWine < 100
        REPLACE Number WITH STR(FinalWine,2)
    CASE FinalWine < 1000
        REPLACE Number WITH STR(FinalWine,3)
    CASE FinalWine < 10000
        REPLACE Number WITH STR(FinalWine,4)
    OTHERWISE
        ERASE
        @  8,14 SAY "YOU HAVE TOO MANY DIFFERENT WINE NAMES FOR THIS SYSTEM."
        @ 10,13 SAY "CONTACT STEPHEN L. HAYNES ASSOCIATES, INC., FOR SUPPORT"
        @ 18,1
        WAIT
        CLEAR
        RETURN
ENDCASE

REPLACE Key WITH WineKey

ERASE
SET FORMAT TO WineScrn
READ
SET FORMAT TO SCREEN

RETURN

* WINESCRN.FMT: Screen format for entry of basic wine information.
* COPYRIGHT (C) 1985 By Stephen L. Haynes Associates, Inc.
*
@  2,32 SAY "WINE ENTRY SCREEN"
@  5,24 SAY "NUMBER"
@  5,31 SAY Number
@  5,47 SAY "KEY"
@  5,51 GET Key PICTURE '!!!!!!!!!!'
@  8, 7 SAY "VINEYARD  >>>>>"
@  8,23 GET Vineyard
@ 10, 7 SAY "NAME  >>>>>>>>>"
@ 10,23 GET Name
@ 11, 7 SAY "SPECIAL  >>>>>>"
@ 11,23 GET Special
@ 12, 7 SAY "APPELLATION  >>"
@ 12,23 GET Appell
@ 14, 7 SAY "TYPE  >>>>>>>>>"
@ 14,23 GET Type PICTURE '!!!!!!'
@ 15, 7 SAY "REGION  >>>>>>>"
@ 15,23 GET Region PICTURE '!!!!!!'

* WINEDATA.CMD:  Subroutine to enter cellar data or tasting notes
* COPYRIGHT (C) 1985 By Stephen L. Haynes Associates, Inc.
* REV:  11/23/85

SET DELETE ON

STORE TRIM(Vineyard) + ' ' + Type + ' ' + TRIM(Name) + ' ' + TRIM(Special);
    + ' (' + TRIM(Appell) + ')' TO Line1

DO CASE
    CASE LEN(Line1) < 73
        STORE ' ' TO Line2
    CASE @(' ',$(Line1,65,8)) <> 0
        STORE $(Line1,65 + @(' ',$(Line1,65,8))) TO Line2
        STORE $(Line1,1,65 + @(' ',$(Line1,65,8)) - 2) TO Line1
    CASE @(' ',$(Line1,60,5)) <> 0
        STORE $(Line1,60 + @(' ',$(Line1,60,5))) TO Line2
        STORE $(Line1,1,60 + @(' ',$(Line1,60,5)) - 2) TO Line1
    CASE @(' ',$(Line1,55,5)) <> 0
        STORE $(Line1,55 + @(' ',$(Line1,55,5))) TO Line2
        STORE $(Line1,1,55 + @(' ',$(Line1,55,5)) - 2) TO Line1
    CASE @(' ',$(Line1,50,5)) <> 0
        STORE $(Line1,50 + @(' ',$(Line1,50,5))) TO Line2
        STORE $(Line1,1,50 + @(' ',$(Line1,50,5)) - 2) TO Line1
    OTHERWISE
        STORE $(TRIM(Vineyard) + ' ' + Type + ' ' + TRIM(Name),1,72);
            TO Line1
        STORE $(TRIM(Special) + ' (' + TRIM(Appell) + ')',1,72);
            TO Line2
ENDCASE

ERASE

IF Annum = '  '

    DO SelecLst
ENDIF

STORE Number + Annum TO Target

STORE ' ' TO Choice

DO WHILE Choice <> 'Z'

    ERASE
    @  2, 5 SAY Annum + ' ' + Line1
    @  3,10 SAY Line2
    @  6,22 SAY "SELECT ONE OF THE FOLLOWING FUNCTIONS:"
    @  8,24 SAY "A.  REVIEW OR MODIFY PRINCIPAL CATALOG ENTRY"
    @  9,24 SAY "B.  REVIEW OR MODIFY CELLAR STORAGE RECORD"
    @ 10,24 SAY "C.  ADD TASTING NOTES OR COMMENTARY"
    @ 11,24 SAY "D.  REVIEW TASTING NOTES OR COMMENTARY"
    @ 12,24 SAY "E.  CHANGE YEAR -- SAME WINE"
    @ 16,24 SAY "Z.  NO MORE FUNCTIONS"
    @ 18,24 GET Choice PICTURE '!'
    READ NOUPDATE
    ERASE

    DO CASE

        CASE Choice = 'Z'
        RETURN

        CASE Choice = 'C'

        SELECT SECONDARY
        IF .NOT. Status
            USE Vintage INDEX Vntg/Key
            STORE T TO Status
        ENDIF

        DO AddCmt

        CASE Choice = 'B'

        SELECT SECONDARY
        IF Status
            USE CellStor INDEX CellStor
            STORE F TO Status
        ENDIF

        FIND '&Target'

        IF # <> 0

            DO ChngRcrd

        ELSE

            ERASE
            STORE F TO TryAgain
            @  6, 6 SAY "YOU MAY HAVE ENTERED THE WRONG VINTAGE, SINCE NO ENTRY HAS BEEN FOUND"
            @  8,14 SAY "DO YOU WISH TO PROCEED, CREATING A NEW STORAGE RECORD?"
            @ 10,40 GET TryAgain PICTURE '!'
            READ NOUPDATE

            IF TryAgain

                APPEND BLANK
                REPLACE Number WITH P.Number
                REPLACE Year WITH Annum
                REPLACE Continue WITH T
                SET CARRY ON

                DO WHILE Continue

                    REPLACE Continue WITH F

                    ERASE
                    SET FORMAT TO CellCard
                    READ NOUPDATE
                    SET FORMAT TO SCREEN

                    IF Continue
                        APPEND BLANK
                    ENDIF
                ENDDO

                SET CARRY OFF
            ENDIF
        ENDIF

        CASE Choice = 'A'

        ERASE
        SET FORMAT TO WineScrn
        READ
        SET FORMAT TO SCREEN

        STORE TRIM(Vineyard) + ' ' + Type + ' ' + TRIM(Name) + ' ';
            + TRIM(Special) + ' (' + TRIM(Appell) + ')' TO Line1

        DO CASE
            CASE LEN(Line1) < 73
            STORE ' ' TO Line2
            CASE @(' ',$(Line1,65,8)) <> 0
            STORE $(Line1,65 + @(' ',$(Line1,65,8))) TO Line2
            STORE $(Line1,1,65 + @(' ',$(Line1,65,8)) - 2) TO Line1
            CASE @(' ',$(Line1,60,5)) <> 0
            STORE $(Line1,60 + @(' ',$(Line1,60,5))) TO Line2
            STORE $(Line1,1,60 + @(' ',$(Line1,60,5)) - 2) TO Line1
            CASE @(' ',$(Line1,55,5)) <> 0
            STORE $(Line1,55 + @(' ',$(Line1,55,5))) TO Line2
            STORE $(Line1,1,55 + @(' ',$(Line1,55,5)) - 2) TO Line1
            CASE @(' ',$(Line1,50,5)) <> 0
            STORE $(Line1,50 + @(' ',$(Line1,50,5))) TO Line2
            STORE $(Line1,1,50 + @(' ',$(Line1,50,5)) - 2) TO Line1
            OTHERWISE
            STORE $(TRIM(Vineyard) + ' ' + Type + ' ' +;
                TRIM(Name),1,72) TO Line1
            STORE $(TRIM(Special) + ' (' + TRIM(Appell) +;
                ')',1,72) TO Line2
        ENDCASE

        CASE Choice = 'D'

        SELECT SECONDARY
        IF .NOT. Status
            USE Vintage INDEX Vntg/Key
            STORE T TO Status
        ENDIF

        FIND '&Target'

        STORE Y TO Continue

        DO WHILE .NOT. EOF .AND. Continue .AND. Number + Year = Target

            ERASE
            STORE F TO Modify
            STORE F TO Options

            IF Clarity + Acescence + Flavor <> 0
                SET FORMAT TO CmtScrn4
            ELSE
                SET FORMAT TO CmtScrn5
            ENDIF

            READ
            SET FORMAT TO SCREEN

            IF Modify

                STORE F TO VeryPoor
                STORE F TO Poor
                STORE F TO Enhances
                SET FORMAT TO CmtScrn1
                READ
                SET FORMAT TO SCREEN
            ENDIF

            IF Options
                DO CmtOptn
            ENDIF

            SKIP
        ENDDO

        CASE Choice = 'E'

        ERASE
        STORE '  ' TO Annum
        @  4, 5 SAY Line1
        @  5, 5 SAY Line2
        @  8,27 SAY "ENTER VINTAGE YEAR CONCERNED"
        @ 10,39 GET Annum PICTURE '!!'
        @ 14,19 SAY "'NV' FOR NON-VINTAGE"
        @ 16,19 SAY "IF NO ENTRY, SYSTEM WILL DISPLAY SELECTIONS"
        @ 17,19 SAY "IN STORAGE AND ALL TASTING NOTES"
        READ

        IF Annum = '  '

            DO SelecLst
        ENDIF

        STORE Number + Annum TO Target

        OTHERWISE
        RETURN
    ENDCASE

    SELECT PRIMARY

ENDDO

RETURN

* SELECLST.CMD:  Subroutine to display years of current stock and notes
* COPYRIGHT (C) 1982,1983 By Stephen L. Haynes Associates, Inc.
* REV:  3/18/83

ERASE
@  1, 5 SAY Line1
@  2, 5 SAY Line2
@  3, 1 SAY "*******************************************************************************"
@  4, 6 SAY "FOLLOWING IS A LISTING OF YEARS OF WINES IN STOCK IN THE WINE CELLAR,"
@  5, 7 SAY "TOGETHER WITH A LISTING OF YEARS OF WINES REVIEWED IN TASTING NOTES"
@  6, 1 SAY "*******************************************************************************"
@  7, 4 SAY "WINES IN STOCK:                     |    WINES REVIEWED:"
@  8,40 SAY "|"
@  9,40 SAY "|"
@ 10,40 SAY "|"
@ 11,40 SAY "|"
@ 12,13 SAY "PROCESSING                 |              PROCESSING"
@ 13, 9 SAY "PLEASE BE PATIENT              |          PLEASE BE PATIENT"
@ 14,40 SAY "|"
@ 15,40 SAY "|"
@ 16,40 SAY "|"
@ 17,40 SAY "|"
@ 18,40 SAY "|"
@ 19,40 SAY "|"
@ 20,40 SAY "|"
@ 21, 1 SAY "*******************************************************************************"
READ

STORE Number TO Target

SELECT SECONDARY
IF Status
    USE CellStor INDEX CellStor
    STORE F TO Status
ENDIF

FIND '&Target'

@ 12,13 SAY "          "
@ 13, 9 SAY "                 "

DO WHILE .NOT. EOF .AND. # <> 0 .AND. Number = Target
    STORE 1 TO Column
    DO WHILE .NOT. EOF .AND. Number = Target .AND. Column < 28
        STORE 8 TO Line
        DO WHILE .NOT. EOF .AND. Number = Target .AND. Line < 21
            STORE Year TO Annum
            IF Year <> 'NV'
                @ Line,Column SAY "19"+Year
            ELSE
                @ Line,Column SAY "  "+Year
            ENDIF
            DO WHILE .NOT. EOF .AND. Number = Target .AND.;
                    Year = Annum
                SKIP
            ENDDO
            STORE Line + 1 TO Line
        ENDDO
        STORE Column + 8 TO Column
    ENDDO
ENDDO

USE Vintage INDEX Vntg/Key
STORE T TO Status

FIND '&Target'

@ 12,55 SAY "          "
@ 13,51 SAY "                 "

DO WHILE .NOT. EOF .AND. # <> 0 .AND. Number = Target
    STORE 42 TO Column
    DO WHILE .NOT. EOF .AND. Number = Target .AND. Column < 67
        STORE 8 TO Line
        DO WHILE .NOT. EOF .AND. Number = Target .AND. Line < 21
            STORE Year TO Annum
            IF Year <> 'NV'
                @ Line,Column SAY "19"+Year
            ELSE
                @ Line,Column SAY "  "+Year
            ENDIF
            DO WHILE .NOT. EOF .AND. Number = Target .AND.;
                    Year = Annum
                SKIP
            ENDDO
            STORE Line + 1 TO Line
        ENDDO
        STORE Column + 8 TO Column
    ENDDO
ENDDO

SELECT PRIMARY

STORE '  ' TO Annum
@ 22, 5 SAY "ENTER VINTAGE YEAR SELECTED >> " GET Annum PICTURE '!!'
READ
ERASE

RETURN

*ADDCMT.CMD:  Subroutine to add critical evaluation of individual bottles
*             of wine from cellar or separately tasted
*COPYRIGHT (C) 1982 By Stephen L. Haynes Associates, Inc.
*REV:  11/19/84

APPEND BLANK
REPLACE Number WITH P.Number
REPLACE Year WITH Annum

ERASE
STORE ' ' TO Choice

DO WHILE Choice <> 'A' .AND. Choice <> 'B' .AND. Choice <> 'C'

    @  4, 5 SAY "********************************************************************"
    @  6,13 SAY "CHOOSE ONE OF THE THREE FOLLOWING EVALUATION APPROACHES:"
    @  8,18 SAY "A.  COMMENTARY - NO NUMERIC RATING"
    @  9,18 SAY "B.  COMMENTARY AND SHORT-FORM NUMERIC RATING"
    @ 10,18 SAY "C.  COMMENTARY AND COMPLETE NUMERIC EVALUATION"
    @ 12,18 GET Choice PICTURE '!'
    @ 14, 5 SAY "********************************************************************"
    READ NOUPDATE
ENDDO

STORE N TO FromRack

@ 17,15 SAY "BOTTLE SELECTED FROM RACK? (Y/N) " GET FromRack PICTURE '!'
READ

IF FromRack

    STORE Number + Year + Rack TO Rack
ENDIF

ERASE
DO CASE

    CASE Choice = 'A'

        SET FORMAT TO CmtScrn3
        READ NOUPDATE
        SET FORMAT TO SCREEN

        ERASE
        @  8,22 SAY "DO YOU HAVE AN OVERALL NUMERIC SCORE?"
        @ 10,38 GET Score
        READ
        ERASE

    CASE Choice = 'B'

        STORE 0 TO Appear
        STORE 0 TO Nose
        STORE 0 TO Taste
        SET FORMAT TO CmtScrn2
        READ NOUPDATE
        SET FORMAT TO SCREEN
        REPLACE Score WITH Appear + Nose + Taste + General

    CASE Choice = 'C'

        STORE F TO VeryPoor
        STORE F TO Poor
        STORE F TO Enhances
        SET FORMAT TO CmtScrn1
        READ NOUPDATE
        SET FORMAT TO SCREEN
        REPLACE Score WITH Clarity + Color + Bouquet + Acescence +;
            Acid + Sweet + Body + Flavor + Tannin +;
            Finish + General

ENDCASE

IF Choice = 'C'

    DO CASE

        CASE VeryPoor

            REPLACE Score WITH Score - 2

        CASE Poor

            REPLACE Score WITH Score - 1

    ENDCASE
ENDIF

RETURN

* CMTSCRN1.FMT:  Full commentary and numeric evaluation.
* COPYRIGHT (C) 1985 By Stephen L. Haynes Associates, Inc.
*
@  1, 1 SAY "| SENSORY EVALUATION CARD |"
@  1,29 SAY Year
@  1,32 SAY $(Line1,1,46)
@  1,79 SAY "|"
@  2, 1 SAY "|  Date Tasted"
@  2,16 GET Date PICTURE 'XX/XX/XX'
@  2,27 SAY "|"
@  2,31 SAY $(Line2,1,47)
@  2,79 SAY "|"
@  3, 1 SAY "+-------------------------+---------------------------------------------------+"
@  4,52 SAY "Format"
@  4,59 GET Format
@  4, 1 SAY "| Appearance:  Clarity (0-1)"
@  4,29 GET Clarity
@  4,35 SAY "Color (0-1)"
@  4,46 GET Color
@  4,79 SAY "|"
@  5, 1 SAY "|"
@  5,15 GET Looks1
@  5,79 SAY "|"
@  6, 1 SAY "|"
@  6,15 GET Looks2
@  6,79 SAY "|"
@  7, 1 SAY "+-----------------------------------------------------------------------------+"
@  8, 1 SAY "| Bouquet:  Character (0-3)"
@  8,28 GET Bouquet
@  8,34 SAY "Acescence (0-1)"
@  8,49 GET Acescence
@  8,79 SAY "|"
@  9, 1 SAY "|Very Poor"
@  9,12 GET VeryPoor PICTURE '!'
@  9,79 SAY "|"
@ 10, 1 SAY "|     Poor"
@ 10,12 GET Poor PICTURE '!'
@ 10,79 SAY "|"
@ 11, 1 SAY "| Enhances"
@ 11,12 GET Enhances PICTURE '!'
@  9,15 GET Nose1
@ 10,15 GET Nose2
@ 11,15 GET Nose3
@ 11,79 SAY "|"
@ 12, 1 SAY "+-----------------------------------------------------------------------------+"
@ 13, 1 SAY "| Taste/Body/Balance/Finish:  Acid balance (0-2)"
@ 13,49 GET Acid
@ 13,55 SAY "Dry/Sweet (0-1)"
@ 13,70 GET Sweet
@ 13,79 SAY "|"
@ 14, 1 SAY "|               Body (0-2)"
@ 14,27 GET Body
@ 14,33 SAY "Flavor (0-3)"
@ 14,45 GET Flavor
@ 14,51 SAY "Astringency (0-2)"
@ 14,68 GET Tannin
@ 14,79 SAY "|"
@ 15, 1 SAY "| Finish"
@ 16, 1 SAY "|  (0-2)"
@ 17, 3 GET Finish
@ 15,15 GET Taste1
@ 15,79 SAY "|"
@ 16,15 GET Taste2
@ 16,79 SAY "|"
@ 17, 1 SAY "|"
@ 17,15 GET Taste3
@ 17,79 SAY "|"
@ 18, 1 SAY "+-----------------------------------------------------------------------------+"
@ 19, 1 SAY "| Overall:"
@ 20, 1 SAY "|  (0-2)"
@ 20, 9 GET General
@ 19,15 GET Overall1
@ 19,79 SAY "|"
@ 20,15 GET Overall2
@ 20,79 SAY "|"
@ 21, 1 SAY "+-----------------------------------------------------------------------------+"
@ 22, 1 SAY "| Postscript:"
@ 22,15 GET Postscript
@ 22,79 SAY "|"

* CMTSCRN2.FMT:  Full commentary and abbreviated numeric evaluation.
* COPYRIGHT (C) 1985 By Stephen L. Haynes Associates, Inc.
*
@  1, 1 SAY "| SENSORY EVALUATION CARD |"
@  1,29 SAY Year
@  1,32 SAY $(Line1,1,46)
@  1,79 SAY "|"
@  2, 1 SAY "|  Date Tasted"
@  2,16 GET Date PICTURE 'XX/XX/XX'
@  2,27 SAY "|"
@  2,31 SAY $(Line2,1,47)
@  2,79 SAY "|"
@  3, 1 SAY "+-------------------------+---------------------------------------------------+"
@  4,52 SAY "Format"
@  4,59 GET Format
@  4, 1 SAY "| Appearance:                 (0-2)"
@  4,38 GET Appear PICTURE '9.9'
@  4,79 SAY "|"
@  5, 1 SAY "|"
@  5,15 GET Looks1
@  5,79 SAY "|"
@  6, 1 SAY "|"
@  6,15 GET Looks2
@  6,79 SAY "|"
@  7, 1 SAY "+-----------------------------------------------------------------------------+"
@  8, 1 SAY "| Bouquet:                    (0-4)"
@  8,38 GET Nose PICTURE '9.9'
@  8,79 SAY "|"
@  9, 1 SAY "|"
@  9,15 GET Nose1
@  9,79 SAY "|"
@ 10, 1 SAY "|"
@ 10,15 GET Nose2
@ 10,79 SAY "|"
@ 11, 1 SAY "|"
@ 11,15 GET Nose3
@ 11,79 SAY "|"
@ 12, 1 SAY "+-----------------------------------------------------------------------------+"
@ 13, 1 SAY "| Taste/Body/Balance/Finish:  (0-12)"
@ 13,38 GET Taste PICTURE '99.9'
@ 13,79 SAY "|"
@ 14, 1 SAY "|"
@ 14,15 GET Taste1
@ 14,79 SAY "|"
@ 15, 1 SAY "|"
@ 15,15 GET Taste2
@ 15,79 SAY "|"
@ 16, 1 SAY "|"
@ 16,15 GET Taste3
@ 16,79 SAY "|"
@ 17, 1 SAY "+-----------------------------------------------------------------------------+"
@ 18, 1 SAY "| Overall:"
@ 19, 1 SAY "|  (0-2)"
@ 19, 9 GET General PICTURE '9.9'
@ 18,15 GET Overall1
@ 18,79 SAY "|"
@ 19,15 GET Overall2
@ 19,79 SAY "|"
@ 20, 1 SAY "+-----------------------------------------------------------------------------+"
@ 21, 1 SAY "| Postscript:"
@ 21,15 GET Postscript
@ 21,79 SAY "|"
@ 22, 1 SAY "+-----------------------------------------------------------------------------+"

* CMTSCRN3.FMT:  Full commentary, only total numeric evaluation.
* COPYRIGHT (C) 1985 By Stephen L. Haynes Associates, Inc.
*
@  1, 1 SAY "| SENSORY EVALUATION CARD |"
@  1,29 SAY Year
@  1,32 SAY $(Line1,1,46)
@  1,79 SAY "|"
@  2, 1 SAY "|  Date Tasted"
@  2,16 GET Date PICTURE 'XX/XX/XX'
@  2,27 SAY "|"
@  2,31 SAY $(Line2,1,47)
@  2,79 SAY "|"
@  3, 1 SAY "+-------------------------+---------------------------------------------------+"
@  4, 1 SAY "| Appearance:                                      Format"
@  4,59 GET Format
@  4,79 SAY "|"
@  5, 1 SAY "|"
@  5,15 GET Looks1
@  5,79 SAY "|"
@  6, 1 SAY "|"
@  6,15 GET Looks2
@  6,79 SAY "|"
@  7, 1 SAY "+-----------------------------------------------------------------------------+"
@  8, 1 SAY "| Bouquet:                                                                    |"
@  9, 1 SAY "|"
@  9,15 GET Nose1
@  9,79 SAY "|"
@ 10, 1 SAY "|"
@ 10,15 GET Nose2
@ 10,79 SAY "|"
@ 11, 1 SAY "|"
@ 11,15 GET Nose3
@ 11,79 SAY "|"
@ 12, 1 SAY "+-----------------------------------------------------------------------------+"
@ 13, 1 SAY "| Taste/Body/Balance/Finish:                                                  |"
@ 14, 1 SAY "|"
@ 14,15 GET Taste1
@ 14,79 SAY "|"
@ 15, 1 SAY "|"
@ 15,15 GET Taste2
@ 15,79 SAY "|"
@ 16, 1 SAY "|"
@ 16,15 GET Taste3
@ 16,79 SAY "|"
@ 17, 1 SAY "+-----------------------------------------------------------------------------+"
@ 18, 1 SAY "| Overall:"
@ 18,15 GET Overall1
@ 18,79 SAY "|"
@ 19, 1 SAY "|"
@ 9,15 GET Overall2
@ 19,79 SAY "|"
@ 20, 1 SAY "+-----------------------------------------------------------------------------+"
@ 21, 1 SAY "| Postscript:"
@ 21,15 GET Postscript
@ 21,79 SAY "|"
@ 22, 1 SAY "+-----------------------------------------------------------------------------+"

* CMTSCRN4.FMT: Display of full commentary and numeric analysis.
* COPYRIGHT (C) 1985 By Stephen L. Haynes Associates, Inc.
*
@  1, 1 SAY "| SENSORY EVALUATION CARD |"
@  1,29 SAY Year
@  1,32 SAY $(Line1,1,46)
@  1,79 SAY "|"
@  2, 1 SAY "|  Date Tasted"
@  2,16 SAY Date
@  2,27 SAY "|"
@  2,31 SAY $(Line2,1,47)
@  2,79 SAY "|"
@  3, 1 SAY "+-------------------------+---------------------------------------------------+"
@  4, 1 SAY "| Appearance:  Clarity (0-1)"
@  4,30 SAY Clarity
@  4,34 SAY " Color (0-1)"
@  4,47 SAY Color
@  4,51 SAY " Format"
@  4,60 SAY Format
@  4,79 SAY "|"
@  5, 1 SAY "|            |"
@  5,15 SAY Looks1
@  5,79 SAY "|"
@  6, 1 SAY "|            |"
@  6,15 SAY Looks2
@  6,79 SAY "|"
@  7, 1 SAY "+-----------------------------------------------------------------------------+"
@  8, 1 SAY "| Bouquet:  Character (0-3)"
@  8,29 SAY Bouquet
@  8,34 SAY "Acescence (0-1)"
@  8,50 SAY Acescence
@  8,79 SAY "|"
@  9, 1 SAY "|"
@  9,14 SAY "|"
@  9,15 SAY Nose1
@  9,79 SAY "|"
@ 10, 1 SAY "|"
@ 10,14 SAY "|"
@ 10,15 SAY Nose2
@ 10,79 SAY "|"
@ 11, 1 SAY "|"
@ 11,14 SAY "|"
@ 11,15 SAY Nose3
@ 11,79 SAY "|"
@ 12, 1 SAY "+-----------------------------------------------------------------------------+"
@ 13, 1 SAY "| Taste/Body/Balance/Finish:  Acid balance (0-2)"
@ 13,50 SAY Acid
@ 13,55 SAY "Dry/Sweet (0-1)"
@ 13,71 SAY Sweet
@ 13,79 SAY "|"
@ 14, 1 SAY "|               Body (0-2)"
@ 14,28 SAY Body
@ 14,32 SAY " Flavor (0-3)"
@ 14,46 SAY Flavor
@ 14,50 SAY " Astringency (0-2)"
@ 14,69 SAY Tannin
@ 14,79 SAY "|"
@ 15, 1 SAY "| Finish     |"
@ 15,15 SAY Taste1
@ 15,79 SAY "|"
@ 16, 1 SAY "|  (0-2)     |"
@ 16,15 SAY Taste2
@ 16,79 SAY "|"
@ 17, 1 SAY "|"
@ 17, 3 SAY Finish
@ 17,14 SAY "|"
@ 17,15 SAY Taste3
@ 17,79 SAY "|"
@ 18, 1 SAY "+-----------------------------------------------------------------------------+"
@ 19, 1 SAY "| Overall:   |"
@ 19,15 SAY Overall1
@ 20, 1 SAY "|  (0-2)"
@ 20, 9 SAY General
@ 20,14 SAY "|"
@ 20,15 SAY Overall2
@ 19,73 SAY "Score |"
@ 20,74 SAY Score
@ 20,79 SAY "|"
@ 21, 1 SAY "+-----------------------------------------------------------------------------+"
@ 22, 1 SAY "| Postscript:"
@ 22,15 SAY Postscript
@  9,69 SAY "Modify?"
@  9,77 GET Modify PICTURE '!'
@ 10,67 SAY "Continue?"
@ 10,77 GET Continue PICTURE '!'
@ 11,68 SAY "Options?"
@ 11,77 GET Options PICTURE '!'
@ 22,79 SAY "|"

* CMTSCRN5.FMT:  Display of full commentary and abbreviated numeric
*                analysis
* COPYRIGHT (C) 1985 By Stephen L. Haynes Associates, Inc.
*
@  1, 1 SAY "| SENSORY EVALUATION CARD |"
@  1,29 SAY Year
@  1,32 SAY $(Line1,1,46)
@  1,79 SAY "|"
@  2, 1 SAY "|  Date Tasted"
@  2,16 SAY Date
@  2,27 SAY "|"
@  2,31 SAY $(Line2,1,47)
@  2,79 SAY "|"
@  3, 1 SAY "+-------------------------+---------------------------------------------------+"
@  4, 1 SAY "| Appearance:"
@  4,51 SAY " Format"
@  4,60 SAY Format
@  4,79 SAY "|"
@  5, 1 SAY "|            |"
@  5,15 SAY Looks1
@  5,79 SAY "|"
@  6, 1 SAY "|            |"
@  6,15 SAY Looks2
@  6,79 SAY "|"
@  7, 1 SAY "+-----------------------------------------------------------------------------+"
@  8, 1 SAY "| Bouquet:"
@  8,79 SAY "|"
@  9, 1 SAY "|"
@  9,14 SAY "|"
@  9,15 SAY Nose1
@  9,79 SAY "|"
@ 10, 1 SAY "|"
@ 10,14 SAY "|"
@ 10,15 SAY Nose2
@ 10,79 SAY "|"
@ 11, 1 SAY "|"
@ 11,14 SAY "|"
@ 11,15 SAY Nose3
@ 11,79 SAY "|"
@ 12, 1 SAY "+-----------------------------------------------------------------------------+"
@ 13, 1 SAY "| Taste/Body/Balance/Finish:"
@ 13,79 SAY "|"
@ 14, 1 SAY "|"
@ 14,79 SAY "|"
@ 15, 1 SAY "|"
@ 15,15 SAY Taste1
@ 15,79 SAY "|"
@ 16, 1 SAY "|"
@ 16,15 SAY Taste2
@ 16,79 SAY "|"
@ 17, 1 SAY "|"
@ 17,14 SAY "|"
@ 17,15 SAY Taste3
@ 17,79 SAY "|"
@ 18, 1 SAY "+-----------------------------------------------------------------------------+"
@ 19, 1 SAY "| Overall:   |"
@ 19,15 SAY Overall1
@ 20, 1 SAY "|"
@ 20,14 SAY "|"
@ 20,15 SAY Overall2
@ 19,73 SAY "Score |"
@ 20,74 SAY Score
@ 20,79 SAY "|"
@ 21, 1 SAY "+-----------------------------------------------------------------------------+"
@ 22, 1 SAY "| Postscript:"
@ 22,15 SAY Postscript
@  9,69 SAY "Modify?"
@  9,77 GET Modify PICTURE '!'
@ 10,67 SAY "Continue?"
@ 10,77 GET Continue PICTURE '!'
@ 11,68 SAY "Options?"
@ 11,77 GET Options PICTURE '!'
@ 22,79 SAY "|"

* CHNGRCRD.CMD:  Subroutine that locates proper cellar storage card, then
*                prompts the opportunity to change it, or if it doesn't exist,
*                prompts the opportunity to add a new one.
* COPYRIGHT (C) 1982,1983 By Stephen L. Haynes Associates, Inc.
* REV:  7/29/83

STORE F TO Hit
STORE T TO AnotherRec

DO WHILE AnotherRec

    STORE # TO GoBack
    ERASE
    SET FORMAT TO CellCrd1
    READ NOUPDATE
    SET FORMAT TO SCREEN

    IF .NOT. Continue .OR. Hit

        STORE F TO AnotherRec

        IF .NOT. Hit

            SKIP

            IF .NOT. EOF .AND. Number + Year = Target

            STORE T TO NewRecord
            ERASE
            @  7,12 SAY "THIS WINE HAS ANOTHER STORAGE RECORD, PREVIOUSLY DELETED."
            @  9,12 SAY "DO YOU WISH TO RESTORE THIS STORAGE RECORD FOR REVISION?"
            @ 11,20 SAY "(IF YOU ANSWER 'N', THE RECORD WILL BE"
            @ 12,20 SAY " PERMANENTLY DELETED TO PREVENT CONFUSION)"
            @ 14,39 GET NewRecord PICTURE '!'
            READ NOUPDATE

            IF NewRecord

                SKIP -1
                REPLACE Continue WITH T
                SKIP
                STORE T TO AnotherRec
            ELSE
                DELETE
            ENDIF
            ENDIF
        ENDIF
    ELSE
        SKIP
    ENDIF

    IF EOF .OR. Number + Year <> Target
        STORE F TO AnotherRec
    ENDIF

ENDDO

IF .NOT. Hit

    ERASE
    STORE T TO NewRecord
    @  6,15 SAY "DO YOU WISH TO CREATE ANOTHER CELLAR STORAGE RECORD?"
    @  8,40 GET NewRecord PICTURE '!'
    READ

    IF NewRecord

        GOTO GoBack
        REPLACE Continue WITH T

        DO WHILE Continue

            STORE T TO CopyData
            @ 10, 8 SAY "DO YOU WISH TO TRANSFER PURCHASE STATISTICS FROM PREVIOUS RECORD?"
            @ 12,40 GET CopyData PICTURE '!'
            READ
            ERASE

            IF CopyData

                STORE Importer TO ImporterX
                STORE Pur:Store TO Pur:StoreX
                STORE Pur:Date TO Pur:DateX
                STORE Price TO PriceX
                STORE Begin TO BeginX
                STORE End TO EndX

                APPEND BLANK

                REPLACE Number WITH P.Number
                REPLACE Year WITH Annum
                REPLACE Continue WITH F
                REPLACE Importer WITH ImporterX
                REPLACE Pur:Store WITH Pur:StoreX
                REPLACE Pur:Date WITH Pur:DateX
                REPLACE Price WITH PriceX
                REPLACE Begin WITH BeginX
                REPLACE End WITH EndX
            ELSE

                APPEND BLANK
                REPLACE Number WITH P.Number
                REPLACE Year WITH Annum
                REPLACE Continue WITH F
            ENDIF

            SET FORMAT TO CellCard
            READ
            SET FORMAT TO SCREEN
            ERASE
        ENDDO
    ENDIF
ELSE

    STORE T TO Amend
    ERASE
    @  8,13 SAY "DO YOU WISH TO AMEND THE CURRENT CELLAR STORAGE RECORD?"
    @ 10,40 GET Amend PICTURE '!'
    READ

    IF Amend

        SET FORMAT TO CellCard
        READ NOUPDATE
        SET FORMAT TO SCREEN

    ENDIF
ENDIF

RETURN

* CELLCARD.FMT:  Format for entry of purchase information.
* COPYRIGHT (C) 1985 By Stephen L. Haynes Associates, Inc.
*
@  1,29 SAY "CELLAR STORAGE RECORD"
@  2, 1 SAY "+-----------------------------------------------------------------------------+"
@  3, 1 SAY "|"
@  3, 3 SAY Annum
@  3, 6 SAY Line1
@  3,79 SAY "|"
@  4, 1 SAY "|"
@  4, 8 SAY Line2
@  4,79 SAY "|"
@  5, 1 SAY "+-----------------------------------------------------------------------------+"
@  6, 1 SAY "|         IMPORTER"
@  6,20 GET Importer
@  6,79 SAY "|"
@  7, 1 SAY "|     STORE                                                                   |"
@  8, 1 SAY "|     WHERE BOUGHT"
@  8,20 GET Pur:Store
@  8,79 SAY "|"
@  9, 1 SAY "|                                                                             |"
@ 10, 1 SAY "|   DATE PURCHASED"
@ 10,20 GET Pur:Date PICTURE 'XX/XX/XX'
@ 10,49 SAY "PRICE"
@ 10,55 GET Price
@ 10,79 SAY "|"
@ 11, 1 SAY "+-----------------------------------------------------------------------------+"
@ 12, 1 SAY "|                                                                             |"
@ 13, 1 SAY "|   NO. OF BOTTLES"
@ 13,20 GET Bottles PICTURE '99'
@ 13,26 SAY "RACKED"
@ 13,33 GET Racked PICTURE '9'
@ 13,38 SAY "BIN/CASE LOCATION"
@ 13,56 GET Bin PICTURE '!!!!!!!'
@ 13,79 SAY "|"
@ 14, 1 SAY "+-----------------------------------------------------------------------------+"
@ 15, 1 SAY "|                                                                             |"
@ 16, 1 SAY "|    YEAR TO BEGIN"
@ 16,20 GET Begin
@ 16,33 SAY "SHOULD BE CONSUMED BY"
@ 16,55 GET End
@ 16,79 SAY "|"
@ 17, 1 SAY "|                                                                             |"
@ 18, 1 SAY "+-----------------------------------------------------------------------------+"
@ 19, 1 SAY "|                                                                             |"
@ 20, 1 SAY "|                                    Continued on another card?"
@ 20,66 GET Continue PICTURE '!'
@ 20,79 SAY "|"
@ 21, 1 SAY "|                                                                             |"
@ 22, 1 SAY "+-----------------------------------------------------------------------------+"

* CELLCRD1.FMT:  Format for display of purchase information.
* COPYRIGHT (C) 1985 By Stephen L. Haynes Associates, Inc.
*
@  1, 1 SAY "CORRECT RECORD?"
@  1,17 GET Hit PICTURE '!'
@  1,29 SAY "CELLAR STORAGE RECORD"
@  2, 1 SAY "+-----------------------------------------------------------------------------+"
@  3, 1 SAY "|"
@  3, 3 SAY Annum
@  3, 6 SAY Line1
@  3,79 SAY "|"
@  4, 1 SAY "|"
@  4, 8 SAY Line2
@  4,79 SAY "|"
@  5, 1 SAY "+-----------------------------------------------------------------------------+"
@  6, 1 SAY "|         IMPORTER"
@  6,20 SAY Importer
@  6,79 SAY "|"
@  7, 1 SAY "|     STORE                                                                   |"
@  8, 1 SAY "|     WHERE BOUGHT"
@  8,20 SAY Pur:Store
@  8,79 SAY "|"
@  9, 1 SAY "|                                                                             |"
@ 10, 1 SAY "|   DATE PURCHASED"
@ 10,20 SAY Pur:Date PICTURE 'XX/XX/XX'
@ 10,49 SAY "PRICE"
@ 10,55 SAY Price
@ 10,79 SAY "|"
@ 11, 1 SAY "+-----------------------------------------------------------------------------+"
@ 12, 1 SAY "|                                                                             |"
@ 13, 1 SAY "|   NO. OF BOTTLES"
@ 13,20 SAY Bottles PICTURE '99'
@ 13,26 SAY "RACKED"
@ 13,33 SAY Racked PICTURE '9'
@ 13,38 SAY "BIN/CASE LOCATION"
@ 13,56 SAY Bin PICTURE '!!!!!!!'
@ 13,79 SAY "|"
@ 14, 1 SAY "+-----------------------------------------------------------------------------+"
@ 15, 1 SAY "|                                                                             |"
@ 16, 1 SAY "|    YEAR TO BEGIN"
@ 16,20 SAY Begin
@ 16,33 SAY "SHOULD BE CONSUMED BY"
@ 16,55 SAY End
@ 16,79 SAY "|"
@ 17, 1 SAY "|                                                                             |"
@ 18, 1 SAY "+-----------------------------------------------------------------------------+"
@ 19, 1 SAY "|                                                                             |"
@ 20, 1 SAY "|                                    Continued on another card?"
@ 20,66 SAY Continue PICTURE '!'
@ 20,79 SAY "|"
@ 21, 1 SAY "|                                                                             |"
@ 22, 1 SAY "+-----------------------------------------------------------------------------+"

* CMTOPTN.CMD:  Subroutine to write retrieved material to disk or printer,
*        or delete contents.
* COPYRIGHT (C) 1983 By Stephen L. Haynes Associates, Inc.
* REV:  3/23/83

STORE ' ' TO Choice

ERASE
SET FORMAT TO CardOptn
READ
SET FORMAT TO SCREEN
ERASE

DO CASE

    CASE Choice = 'A'

        @  8,26 SAY "READY PRINTER AND PRESS RETURN"
        @ 18,1
        WAIT

        SET FORMAT TO PRINT
        SET MARGIN TO 5

        @  1, 1 SAY Year
        @  1, 4 SAY Line1
        @  2, 4 SAY Line2
        @  4, 1 SAY "Date Tasted"
        @  4,13 SAY Date
        @  4,22 SAY "Format"
        @  4,29 SAY Format
        @  6, 1 SAY "Appearance:  Clarity (0-1)"
        @  6,27 SAY Clarity
        @  6,33 SAY "Color (0-1)"
        @  6,44 SAY Color
        @  7,13 SAY Looks1
        @  8,13 SAY Looks2
        @ 10, 0 SAY "Bouquet:  Character (0-3)"
        @ 10,25 SAY Bouquet
        @ 10,31 SAY "Acescence (0-1)"
        @ 10,46 SAY Acescence
        @ 11,13 SAY Nose1
        @ 12,13 SAY Nose2
        @ 13,13 SAY Nose3
        @ 15, 1 SAY "Taste/Body/Balance/Finish:  Acid balance (0-2)"
        @ 15,47 SAY Acid
        @ 15,53 SAY "Dry/Sweet (0-1)"
        @ 15,68 SAY Sweet
        @ 16, 2 SAY "Body (0-2)"
        @ 16,12 SAY Body
        @ 16,18 SAY "Flavor (0-3)"
        @ 16,30 SAY Flavor
        @ 16,36 SAY "Astringency (0-2)"
        @ 16,53 SAY Tannin
        @ 16,59 SAY "Finish (0-2)"
        @ 16,71 SAY Finish
        @ 17,13 SAY Taste1
        @ 18,13 SAY Taste2
        @ 19,13 SAY Taste3
        @ 21, 1 SAY "Overall:"
        @ 21,13 SAY Overall1
        @ 21,71 SAY "Score"
        @ 22, 2 SAY "(0-2)"
        @ 22, 7 SAY General
        @ 22,13 SAY Overall2
        @ 22,72 SAY Score
        @ 24, 1 SAY "Postscript:"
        @ 24,13 SAY Postscript

        SET FORMAT TO SCREEN

    CASE Choice = 'B'

        STORE '              ' TO DiskStore
        @  5,13 SAY "ENTER THE FILE NAME TO WHICH TO WISH THE DOCUMENT STORED"
        @  7,33 GET DiskStore PICTURE '!!!!!!!!!!!!!!'
        @ 10,15 SAY " NOTE:  DEFAULT IS 'JUNK.TXT'"
        @ 12,15 SAY "        IF NO EXTENSION (E.G., '.DOC') IS PROVIDED,"
        @ 13,15 SAY "          SYSTEM WILL PROVIDE '.TXT' EXTENSION"
        @ 15,15 SAY "        NAME MUST BE NORMAL CP/M FORMAT -- NO LONGER"
        @ 16,15 SAY "          THAN EIGHT CHARACTERS PLUS '.' AND THREE"
        @ 17,15 SAY "          CHARACTER EXTENSION"
        @ 19,15 SAY "        FILE NAME MAY BE PRECEDED BY A DRIVE"
        @ 20,15 SAY "          DESIGNATION IN FORM '_:'"
        READ

        RESET

        IF DiskStore = ' '
            STORE 'Junk.TXT' TO DiskStore
        ENDIF

        SET ALTERNATE TO &DiskStore
        SET ALTERNATE ON
        SET RAW ON
        SET CONSOLE OFF

        ? Year + ' ' + Line1
        ? '   ' + Line2
        ?
        ? "Date Tasted " + Date + "   Format " + Format
        ?
        ? "Appearance:  Clarity (0-1) " + STR(Clarity,3,1) +;
            "  Color (0-1) " + STR(Color,3,1)
        ? "            " + Looks1
        ? "            " + Looks2
        ?
        @ 10, 0 SAY "Bouquet:  Character (0-3)"
        @ 10,25 SAY Bouquet
        @ 10,31 SAY "Acescence (0-1)"
        @ 10,46 SAY Acescence
        @ 11,13 SAY Nose1
        @ 12,13 SAY Nose2
        @ 13,13 SAY Nose3
        @ 15, 1 SAY "Taste/Body/Balance/Finish:  Acid balance (0-2)"
        @ 15,47SAY Acid
        @ 15,53 SAY "Dry/Sweet (0-1)"
        @ 15,68 SAY Sweet
        @ 16, 2 SAY "Body (0-2)"
        @ 16,12 SAY Body
        @ 16,18 SAY "Flavor (0-3)"
        @ 16,30 SAY Flavor
        @ 16,36 SAY "Astringency (0-2)"
        @ 16,53 SAY Tannin
        @ 16,59 SAY "Finish (0-2)"
        @ 16,71 SAY Finish
        @ 17,13 SAY Taste1
        @ 18,13 SAY Taste2
        @ 19,13 SAY Taste3
        @ 21, 1 SAY "Overall:"
        @ 21,13 SAY Overall1
        @ 21,71 SAY "Score"
        @ 22, 2 SAY "(0-2)"
        @ 22, 7 SAY General
        @ 22,13 SAY Overall2
        @ 22,72 SAY Score
        @ 24, 1 SAY "Postscript:"
        @ 24,13 SAY Postscript

        SET ALTERNATE OFF
        SET RAW OFF
        SET CONSOLE ON

    CASE Choice = 'C'

        FIND &Target

        ERASE
        STORE F TO Confirm
        @  6,17 SAY "YOU HAVE CHOSEN TO DELETE DOCUMENT NUMBER" + Number
        @  8,19 SAY "DO YOU REALLY WISH TO DELETE THIS DOCUMENT?"
        @ 10,40 GET Confirm PICTURE '!'
        READ

        IF .NOT. Confirm
            RETURN
        ENDIF

        REPLACE Line WITH '**DELETED**'
        SKIP

        DO WHILE .NOT. EOF .AND. Target = TRIM(Number)

            REPLACE Line WITH ' '
            DELETE
            SKIP
        ENDDO

    CASE Choice = 'D'

        STORE F TO NewPage
            @  6,10 SAY "DO YOU WISH EACH SEGMENT/DOCUMENT TO BEGIN ON A SEPARATE PAGE?"
        @  8,40 GET NewPage PICTURE '!'
        READ

        ? CHR(7)
        IF .NOT. NewPage
            @  6, 1
            @  6,15 SAY "BE SURE PRINTER IS LOADED WITH CONTINUOUS FORM PAPER"
        ENDIF
        @  8,26 SAY "READY PRINTER AND PRESS RETURN"
        @ 18,1
        WAIT

        SET FORMAT TO PRINT
        SET MARGIN TO 5
        STORE 1 TO LineX

        SELECT SECONDARY
        STORE # TO GoBack

        DO WHILE .NOT. EOF

            STORE TRIM(Loc1) TO Target

            SELECT PRIMARY
            FIND &Target

            @  LineX,5 SAY "TEXT OF SELECTED DOCUMENT " + Number

            STORE LineX + 2 TO LineX

            DO WHILE .NOT. EOF .AND. Target = TRIM(Number)

                @ LineX,5 SAY Line
                STORE LineX + 1 TO LineX
                SKIP
            ENDDO

            IF NewPage
                EJECT
                STORE 1 TO LineX
                SET FORMAT TO SCREEN
                ERASE
                @  8,33 SAY "INSERT NEW PAGE"
                @ 18,1
                WAIT
                SET FORMAT TO PRINT
            ELSE
                STORE LineX + 3 TO LineX
            ENDIF

            SELECT SECONDARY
            SKIP
        ENDDO

        SET FORMAT TO SCREEN
        SELECT SECONDARY
        GOTO GoBack

    CASE Choice = 'E'

        STORE '              ' TO DiskStore
        @  5,13 SAY "ENTER THE FILE NAME TO WHICH TO WISH THE DOCUMENT STORED"
        @  7,33 GET DiskStore PICTURE '!!!!!!!!!!!!!!'
        @ 10,15 SAY " NOTE:  DEFAULT IS 'JUNK.TXT'"
        @ 12,15 SAY "        IF NO EXTENSION (E.G., '.DOC') IS PROVIDED,"
        @ 13,15 SAY "          SYSTEM WILL PROVIDE '.TXT' EXTENSION"
        @ 15,15 SAY "        NAME MUST BE NORMAL CP/M FORMAT -- NO LONGER"
        @ 16,15 SAY "          THAN EIGHT CHARACTERS PLUS '.' AND THREE"
        @ 17,15 SAY "          CHARACTER EXTENSION"
        @ 19,15 SAY "        FILE NAME MAY BE PRECEDED BY A DRIVE"
        @ 20,15 SAY "          DESIGNATION IN FORM '_:'"
        READ

        RESET

        IF DiskStore = ' '
            STORE 'Junk.TXT' TO DiskStore
        ENDIF

        SET ALTERNATE TO &DiskStore
        SET ALTERNATE ON

        @ 23, 1 SAY "PROCESSING DOCUMENT "
        @ 23,25 SAY " OF "
        @ 23,29 SAY Hits - 1
        SET CONSOLE OFF

        SELECT SECONDARY
        STORE # TO GoBack
        STORE 1 TO Count

        DO WHILE .NOT. EOF

            SET CONSOLE ON
            @ 23,21 SAY STR(Count,2)
            @ 23,79
            SET CONSOLE OFF
            STORE Count + 1 TO Count

            STORE TRIM(Loc1) TO Target

            SELECT PRIMARY
            FIND &Target

            ? "TEXT OF SELECTED DOCUMENT " + Number
            ?

            DO WHILE .NOT. EOF .AND. Target = TRIM(Number)

                ? Line
                SKIP
            ENDDO

            ?
            ? '-------------------------------------------------------------------------------'
            ?
            ?

            SELECT SECONDARY
            SKIP
        ENDDO

        SET ALTERNATE OFF
        SET CONSOLE ON

        SELECT SECONDARY
        GOTO GoBack

    CASE Choice = 'F'

        FIND &Target

        ERASE
        STORE F TO Confirm
        @  6, 8 SAY "YOU HAVE CHOSEN TO DELETE DOCUMENTS BEGINNING WITH NUMBER" + Number
        @  8,18 SAY "DO YOU REALLY WISH TO DELETE THESE DOCUMENTS?"
        @ 10,40 GET Confirm PICTURE '!'
        READ

        IF .NOT. Confirm
            RETURN
        ENDIF

        SELECT SECONDARY

        DO WHILE .NOT. EOF

            STORE TRIM(Loc1) TO Target

            SELECT PRIMARY
            FIND &Target

            REPLACE Line WITH '**DELETED**'
            SKIP

            DO WHILE .NOT. EOF .AND. Target = TRIM(Number)

                REPLACE Line WITH ' '
                DELETE
                SKIP
            ENDDO

            SELECT SECONDARY
            SKIP
        ENDDO

    OTHERWISE

        @  8,30 SAY "INVALID OPTION CHOSEN"
        @ 18, 1
        WAIT
ENDCASE

SELECT PRIMARY

RETURN
***** File CARDOPTN ***
*
*                      SELECT ONE OF THE FOLLOWING OPTIONS:
*
*     A.   Print this screen/document
*
*     B.   Write this screen/document to disk
*
*     C.   Delete this screen/document
*
*     D.   Print all screens/documents in this series (starting with this one)
*
*     E.   Write all screens/documents in this series (starting with this one)
*          to disk
*
*     F.   Delete all screens/documents in this series (starting with this one)
*
*
*
*
*               MAKE YOUR SELECTION:      #Choice

* CARDOPTN.FMT:  For selection of options.
*
@  3,23 SAY "SELECT ONE OF THE FOLLOWING OPTIONS:"
@  5, 6 SAY "A.   Print this screen/document"
@  7, 6 SAY "B.   Write this screen/document to disk"
@  9, 6 SAY "C.   Delete this screen/document"
@ 11, 6 SAY "D.   Print all screens/documents in this series (starting with this one)"
@ 13, 6 SAY "E.   Write all screens/documents in this series (starting with this one)"
@ 14,11 SAY "to disk"
@ 16, 6 SAY "F.   Delete all screens/documents in this series (starting with this one)"
@ 20,16 SAY "MAKE YOUR SELECTION:"
@ 20,42 GET Choice PICTURE '!'